home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / utils / disp187b / drvsrc / cl5426.asm < prev    next >
Encoding:
Assembly Source File  |  1993-12-06  |  11.5 KB  |  402 lines
  1.  := 0;
  2.       end;
  3.     end;
  4.   end;
  5.   WaitToGo;
  6. end; { UserLineStylePlay }
  7.  
  8.  
  9. procedure SayGoodbye;
  10. { Say goodbye and then exit the program }
  11. var
  12.   ViewInfo : ViewPortType;
  13. begin
  14.   MainWindow('');
  15.   GetViewSettings(ViewInfo);
  16.   SetTextStyle(TriplexFont, HorizDir, 4);
  17.   SetTextJustify(CenterText, CenterText);
  18.   with ViewInfo do
  19.     OutTextXY((x2-x1) div 2, (y2-y1) div 2, 'That''s all folks!');
  20.   StatusLine('Press any key to quit...');
  21.   repeat until KeyPressed;
  22. end; { SayGoodbye }
  23.  
  24.  
  25. PROCEDURE SelectMode;
  26. VAR
  27.     choice1,choice2     : CHAR;
  28.    xsize,ysize            : WORD;
  29. BEGIN
  30.     (* Let's select a mode *)
  31.     ClrScr;
  32.     WriteLn('VESADEMO:');
  33.     WriteLn('1. 256 colors');
  34.     WriteLn('2. 32768 colors');
  35.     WriteLn('3. 65536 colors');
  36.     WriteLn('4. 16777216 colors');
  37.     WriteLn('Q uit');
  38.     WriteLn;
  39.     Write('Your choice: ');
  40.     REPEAT
  41.         ReadLn(choice1);
  42.       IF choice1 <> '1' THEN BEGIN
  43.           WriteLn('Sorry !');
  44.          WriteLn('This demo wasn''t written for more as 256 colors !');
  45.          WriteLn('You would only get a limited impression of the Hi-& TrueColor modes...');
  46.          WriteLn('Switching to 256 colors.');
  47.          choice1 := '1';
  48.       END;
  49.     UNTIL choice1 IN ['1'..'4','q'];
  50.     IF choice1 = 'q' THEN Halt;
  51.  
  52.     WriteLn;
  53.     WriteLn;
  54.     WriteLn('a. 320x200');
  55.     WriteLn('b. 640x480');
  56.     WriteLn('c. 800x600');
  57.     WriteLn('d. 1024x768');
  58.     WriteLn('e. 1280x1024');
  59.     WriteLn('Q uit');
  60.     WriteLn;
  61.     Write('Your choice: ');
  62.     REPEAT
  63.         ReadLn(choice2);
  64.     UNTIL choice2 IN ['a'..'e','q'];
  65.     IF choice2 = 'q' THEN Halt;
  66.  
  67.     CASE choice2 OF
  68.         'a' : BEGIN
  69.             xsize := 320;
  70.             ysize := 200;
  71.         END;
  72.         'b' : BEGIN
  73.             xsize := 640;
  74.             ysize := 480;
  75.         END;
  76.         'c' : BEGIN
  77.             xsize := 800;
  78.             ysize := 600;
  79.         END;
  80.         'd' : BEGIN
  81.             xsize := 1024;
  82.             ysize := 768;
  83.         END;
  84.         'e' : BEGIN
  85.             xsize := 1280;
  86.             ysize := 1024;
  87.         END;
  88.     END;
  89.     CASE choice1 OF
  90.         '1' : mode := FindVesaMode(xsize,ysize,8);
  91.         '2' : mode := FindVesaMode(xsize,ysize,15);
  92.         '3' : mode := FindVesaMode(xsize,ysize,16);
  93.         '4' : mode := FindVesaMode(xsize,ysize,24);
  94.     END;
  95.     IF mode = 0 THEN BEGIN
  96.         WriteLn('No such mode could be found !');
  97.         WriteLn('Switching to to 320x200.');
  98.         ReadKey;
  99.         mode := V320x200x256;
  100.     END;
  101. END;
  102.  
  103. begin { program body }
  104.   SelectMode;
  105.   Initialize;
  106.   ReportStatus;
  107.  
  108. {  AspectRatioPlay; }
  109.   FillEllipsePlay;
  110.   SectorPlay;
  111.   WriteModePlay;
  112.  
  113.   ColorPlay;
  114.   { PalettePlay only intended to work on these drivers: }
  115.   if (GraphDriver = EGA) or
  116.       (GraphDriver = EGA64) or
  117.       (GraphDriver = VGA) then
  118.      PalettePlay;
  119.   PutPixelPlay;
  120. {  PutImagePlay; }
  121.   RandBarPlay;
  122.   BarPlay;
  123.   Bar3DPlay;
  124.   ArcPlay;
  125.   CirclePlay;
  126.   PiePlay;
  127.   LineToPlay;
  128.   LineRelPlay;
  129. {  LineStylePlay; }
  130. {  UserLineStylePlay; }
  131.   TextDump;
  132.   TextPlay;
  133.   CrtModePlay;
  134.   FillStylePlay;
  135.   FillPatternPlay;
  136.   PolyPlay;
  137.   SayGoodbye;
  138. {  CloseGraph; }
  139.   CloseVesa;
  140. end.
  141. ***************************************************
  142.     '* SHOW D2ROTATE (ABOUT THE ORIGIN)
  143.     '****************************************************************∞╥≤c≤*φè#^│v/╒:j═φ0t+l▓ô"¬"g└≡?%ªêΣ│H╫½╫╜├¿U'╒⌐⌡ ßV?╩¬ujOΦçEZ1∞▐! ▄B╛Σ8║æ]1GlNÜ┐q▌▓;ô$ΦzE<cª*bEô#ä╧ñÅ"∩─LrdaÖ ╠º╫a^¥£å╬1~)@ëÖMδ╫0═6DäFê¬Çv┼ß╨kæpτ╪É)}ª 1w3╤╧ü⌡¥╓h▓╣≈ïÅaÑ[TⁿHqªÉ╝DKÄ─Y-∞tT╤Θ╨º╟╪.*ÇI9lΦ≈{πτcσ$τπßoFr╪╨∩┼╞╟;O2■e²LÜ4^N|╪½ÅO?╔°FOz`╟╟╟'<>>π$πΘù6·Xgî╖│°oîδπGƒd╝▀░?■╪╔_9L ⌡ôⁿq'æO▀ƒn4╔▀╚▄┼3pτ.òO°·}÷╕ⁿ±'æO?ít│!√8ßÑ≤/┐╣p┼≥┘E╦Vox╕cΦé5╟╚º╙$?√$≥ΘZεsî≡åìΓpKù¢ïß X╥ 9╞≈\µk┤O¥_ 5Üö\≤éÄ┌╤A[╤ÿáï┼éNⁿÅu16    g,%hc╙╨cD╨Vï┘R¢öKñR;8εáΣ╢╪ós╤π╡á└èxgzPÄMú╫yαºÉ+σJ¢i+▓â3╥    ═Ñ╙î^ºG▓█πérφçs %#(╗⌠?┼%u8≡6+QÉ))ò)Afw≈╣╪)B&4░åLXV:δät@Å.;5Φf╢Ät┐ΣJ╫─U8úÇ╟éö£╕p╔┴⌠vg╨╬╥é÷╪╣┬ΓI.ç≡^v╤ZΦÇ& ╒┌6ñô6XßNè╡╬E₧Ñ
  144. kIº╠▄A+╣╥éb²tæ-Y¡½αÑa═uuîÇ╢αêvhuª╡SÅ┤vèùú¥F;p<d⌐/F─d█éT%▓KΦû=q■öI┐ ┐╠6S$▒÷╚ENΩ¥Fû9╔┌R'╝ ╧φ└?g┬j▓0═/b╖₧─mûé╢┌»ÿÄë/·<éò■░╤╟╢├Xσ:╥P3Θ"╬Læsφ░┌öSö!╗¿*mN£WΣÇ£┤~#╗ææ≥RΩóh:à▌.æ≈╕▌v£äàd▒à╒├=░╖π║$howeg*╬    6ù▄ƒô╕φ░Ö╢qΘD>(w@úKεHÆ╛öúΣU
  145. éÜR╔╤W▄èê 2M%ó.▓SNÖA1ùJE╢║l]▓¿>\%└Å4ßO▄£â⌐& ê/)8vSP▀▓ôⁿææ√ü√ÑÄa⌠â╚4S╓╟P- ?Σá╕▓Næ*q╡UΘ▓≈^ñ·I.rúR&$Y^╚%è≡B┌≈Ceat
  146.     Color := RandColor;
  147.     SetColor(Color);
  148.     SetFillStyle(Random(CloseDotFill)+1, Color);
  149.     Bar3D(Random(MaxWidth), Random(MaxHeight),
  150.           Random(MaxWidth), Random(MaxHeight), 0, TopOff);
  151.   until KeyPressed;
  152.   WaitToGo;
  153. end; { RandBarPlay }
  154.  
  155. procedure ArcPlay;
  156. { Draw random arcs on the screen }
  157. var
  158.   MaxRadius : word;
  159.   EndAngle : word;
  160.   ArcInfo : ArcCoordsType;
  161. begin
  162.   MainWindow('Arc / GetArcCoords demonstration');
  163.   StatusLine('Esc aborts or press a key');
  164.   MaxRadius := MaxY div 10;
  165.   repeat
  166.     SetColor(RandColor);
  167.     EndAngle := Random(360);
  168.     SetLineStyle(SolidLn, 0, NormWidth);
  169.     Arc(Random(MaxX), Random(MaxY), Random(EndAngle), EndAngle, Random(MaxRadius));
  170.     GetArcCoords(ArcInfo);
  171.     with ArcInfo do
  172.     begin
  173.       Line(X, Y, XStart, YStart);
  174.       Line(X, Y, Xend, Yend);
  175.     end;
  176.   until KeyPressed;
  177.   WaitToGo;
  178. end; { ArcPlay }
  179.  
  180. procedure PutPixelPlay;
  181. { Demonstrate the PutPixel and GetPixel commands }
  182. const
  183.   Seed   = 1962; { A seed for the random number generator }
  184.   NumPts = 2000; { The number of pixels plotted }
  185.   Esc    = #27;
  186. var
  187.   I : word;
  188.   X, Y, Color : word;
  189.   XMax, YMax  : integer;
  190.   ViewInfo    : ViewPortType;
  191. begin
  192.   MainWindow('PutPixel / GetPixel demonstration');
  193.   StatusLine('Esc aborts or press a key...');
  194.  
  195.   GetViewSettings(ViewInfo);
  196.   with ViewInfo do
  197.   begin
  198.     XMax := (x2-x1-1);
  199.     YMax := (y2-y1-1);
  200.   end;
  201.  
  202.   while not KeyPressed do
  203.   begin
  204.     { Plot random pixels }
  205.     RandSeed := Seed;
  206.     I := 0;
  207.     while (not KeyPressed) and (I < NumPts) do
  208.     begin
  209.       Inc(I);
  210.         PutPixel(Random(XMax)+1, Random(YMax)+1, RandColor);
  211.     end;
  212.  
  213.     { Erase pixels }
  214.     RandSeed := Seed;
  215.     I := 0;
  216.     while (not KeyPressed) and (I < NumPts) do
  217.     begin
  218.       Inc(I);
  219.       X := Random(XMax)+1;
  220.       Y := Random(YMax)+1;
  221.       Color := GetPixel(X, Y);
  222.         if Color = RandColor then
  223.           PutPixel(X, Y, 0);
  224.      end;
  225.   end;
  226.   WaitToGo;
  227. end; { PutPixelPlay }
  228.  
  229. procedure PutImagePlay;
  230. { Demonstrate the GetImage and PutImage commands }
  231.  
  232. const
  233.   r  = 20;
  234.   StartX = 100;
  235.   StartY = 50;
  236.  
  237. var
  238.   CurPort : ViewPortType;
  239.  
  240. procedure MoveSaucer(var X, Y : integer; Width, Height : integer);
  241. var
  242.   Step : integer;
  243. begin
  244.   Step := Random(2*r);
  245.   if Odd(Step) then
  246.     Step := -Step;
  247.   X := X + Step;
  248.   Step := Random(r);
  249.   if Odd(Step) then
  250.     Step := -Step;
  251.   Y := Y + Step;
  252.  
  253.   { Make saucer bounce off viewport walls }
  254.   with CurPort do
  255.   begin
  256.     if (x1 + X + Width - 1 > x2) then
  257.       X := x2-x1 - Width + 1
  258.     else
  259.       if (X < 0) then
  260.         X := 0;
  261.     if (y1 + Y + Height - 1 > y2) then
  262.       Y := y2-y1 - Height + 1
  263.     else
  264.       if (Y < 0) then
  265.         Y := 0;
  266.   end;
  267. end; { MoveSaucer }
  268.  
  269. var
  270.   Pausetime : word;
  271.   Saucer    : pointer;
  272.   X, Y      : integer;
  273.   ulx, uly  : word;
  274.   lrx, lry  : word;
  275.   Size      : word;
  276.   I         : word;
  277. begin
  278.   ClearDevice;
  279.   FullPort;
  280.  
  281.   { PaintScreen }
  282.   ClearDevice;
  283.   MainWindow('GetImage / PutImage Demonstration');
  284.   StatusLine('Esc aborts or press a key...');
  285.   GetViewSettings(CurPort);
  286.  
  287.   { DrawSaucer }
  288.   Ellipse(StartX, StartY, 0, 360, r, (r div 3)+2);
  289.   Ellipse(StartX, StartY-4, 190, 357, r, r div 3);
  290.   Line(StartX+7, StartY-6, StartX+10, StartY-12);
  291.   Circle(StartX+10, StartY-12, 2);
  292.   Line(StartX-7, StartY-6, StartX-10, StartY-12);
  293.   Circle(StartX-10, StartY-12, 2);
  294.   SetFillStyle(SolidFill, MaxColor);
  295.   FloodFill(StartX+1, StartY+4, GetColor);
  296.  
  297.   { ReadSaucerImage }
  298.   ulx := StartX-(r+1);
  299.   uly := StartY-14;
  300.   lrx := StartX+(r+1);
  301.   lry := StartY+(r div 3)+3;
  302.  
  303.   Size := ImageSize(ulx, uly, lrx, lry);
  304.   GetMem(Saucer, Size);
  305.   GetImage(ulx, uly, lrx, lry, Saucer^);
  306. {  PutImage(ulx, uly, Saucer^, XORput);               { erase image }
  307.  
  308.   { Plot some "stars" }
  309.   for I := 1 to 1000 do
  310.      PutPixel(Random(MaxX), Random(MaxY), RandColor);
  311.   X := MaxX div 2;
  312.   Y := MaxY div 2;
  313.   PauseTime := 70;
  314.  
  315.   { Move the saucer around }
  316.   repeat
  317. {     PutImage(X, Y, Saucer^, XORput);                 { draw image }
  318.      Delay(PauseTime);
  319. {     PutImage(X, Y, Saucer^, XORput);                 { erase image }
  320.      MoveSaucer(X, Y, lrx - ulx + 1, lry - uly + 1);  { width/height }
  321.   until KeyPressed;
  322.   FreeMem(Saucer, size);
  323.   WaitToGo;
  324. end; { PutImagePlay }
  325.  
  326. procedure PolyPlay;
  327. { Draw random polygons with random fill styles on the screen }
  328. const
  329.   MaxPts = 5;
  330. type
  331.   PolygonType = array[1..MaxPts] of PointType;
  332. var
  333.   Poly : PolygonType;
  334.   I, Color : word;
  335. begin
  336.   MainWindow('FillPoly demonstration');
  337.   StatusLine('Esc aborts or press a key...');
  338.   repeat
  339.     Color := RandColor;
  340.     SetFillStyle(Random(11)+1, Color);
  341.     SetColor(Color);
  342.     for I := 1 to MaxPts do
  343.       with Poly[I] do
  344.       begin
  345.         X := Random(MaxX);
  346.         Y := Random(MaxY);
  347.       end;
  348.     FillPoly(MaxPts, Poly);
  349.   until KeyPressed;
  350.   WaitToGo;
  351. end; { PolyPlay }
  352.  
  353. procedure FillStylePlay;
  354. { Display all of the predefined fill styles available }
  355. var
  356.   Style    : word;
  357.   Width    : word;
  358.   Height   : word;
  359.   X, Y     : word;
  360.   I, J     : word;
  361.   ViewInfo : ViewPortType;
  362.  
  363. procedure DrawBox(X, Y : word);
  364. begin
  365.   SetFillStyle(Style, MaxColor);
  366.   with ViewInfo do
  367.     Bar(X, Y, X+Width, Y+Height);
  368.   Rectangle(X, Y, X+Width, Y+Height);
  369.   OutTextXY(X+(Width div 2), Y+Height+4, Int2Str(Style));
  370.   Inc(Style);
  371. end; { DrawBox }
  372.  
  373. begin
  374.   MainWindow('Pre-defined fill styles');
  375.   GetViewSettings(ViewInfo);
  376.   with ViewInfo do
  377.   begin
  378.     Width := 2 * ((x2+1) div 13);
  379.     Height := 2 * ((y2-10) div 10);
  380.   end;
  381.   X := Width div 2;
  382.   Y := Height div 2;
  383.   Style := 0;
  384.   for J := 1 to 3 do
  385.   begin
  386.     for I := 1 to 4 do
  387.     begin
  388.       DrawBox(X, Y);
  389.       Inc(X, (Width div 2) * 3);
  390.     end;
  391.     X := Width div 2;
  392.     Inc(Y, (Height div 2) * 3);
  393.   end;
  394.   SetTextJustify(LeftText, TopText);
  395.   WaitToGo;
  396. end; { FillStylePlay }
  397.  
  398. procedure FillPatternPlay;
  399. { Display some user defined fill patterns }
  400. const
  401.   Patterns : array[0..11] of FillPatternType = (
  402.   ($AA, $55, $AA, $55, $AA, $55, $AA, $55 üÖü üÖü  !BBäx!!!BBäx!BBäx"""DDêp""DDêp>"""BBääêp""!"BDäêêp>IÉÆ|      ° @≥î>00>><Dêx  !BBäx""DDêp&<"DDêê&22TTêêê$> $< @äêp>          ⁿBBBB<  @@Ç****DDDDDDDU¬U¬U¬U¬U¬U¬U¬▌w▌w▌w▌w▌w▌w▌w°°°≥■°°≥≥■≥≥■■°°°    ≤  ≤  ≤≤         °                     ≡≡≡≡≡≡≡≡≡≡≡≡≡≡       ;DDD;    $"Bdÿ>@@@>||>Ac]AAA1N"A""2,  `1NA"*III*<Bü üB<<BüüüB<A" \"QIE" < <BBBB  @@    ~ ?  @ÇB$$B ""A$$"AII6 üBr»$**IIII**cc